' This program exported from BASIC Anywhere Machine (Version [5.2.3].[2024.09.09.00.00]) on 2024.12.26 at 04:11 (Coordinated Universal Time)
_TITLE "Saucer Zap"
' BAM port and mod by Charlie Veniot
' of the QBJS by James D. Jarvis, it a mod
' of Plasma Laser Canon demo prep for GUI 2020-11-11

OPTION EXPLICIT
OPTION BASE 1
_INITAUDIO
SCREEN _NEWIMAGE( 1200, 600, 32 )

ALERT( "Click/touch the screen to shoot your spaceship's plasma laser canon at that coordinate." _
       + "\n\n The plasma laser cannon has a limited range, so will not shoot if you click/touch the screen too far away." _
       + "\n\n Moving the ship requires a physical keyboard: [W] for up [S] for down [A] for left [D] for right." _
       + "\n\n Each attack wave will have an increasing number of spaceships.")

'🟠🟠🟠 DECLARE VARIABLES

  DIM AS LONG ShipLights
  DIM AS ULONG ShipColor
  DIM AS LONG cx, cy, mx, my, mb, sx, sy, ix, iy, killflag, x, score
  DIM AS SINGLE ma, md, dx, dy, damage, cdiv
  DIM AS INTEGER targetx(50), targety(50), targetvx(50), targetvy(50), targetalive(50), targets, targetsDestroyed
  DIM targetcolor(50) AS ULONG
  DIM w%, i%, ik$

'🟠🟠🟠 DECLARE SUBROUTINES

  DECLARE SUB PLC( baseX, baseY, targetX, targetY, targetR )
  DECLARE SUB drawShip(x, y, colr AS ULONG )
  DECLARE SUB drawtarget( x, y, colr AS ULONG )
  DECLARE SUB fcirc( CX AS LONG, CY AS LONG, R AS LONG )
  DECLARE SUB fEllipse( CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG )

'🟠🟠🟠 MAIN PROGRAM

  cy = INT( _HEIGHT / 2 ) : cx = INT( _WIDTH / 2 )
  ShipColor = &HFF3366AA

  🏁🏁🏁ProgramStart🏁🏁🏁: 

  LET sx = cx, sy = cy,  _
      mx = 0, my = 0, mb = 0, ix = 0, iy = 0, killflag = 0, x = 0, score = 0, _
      ma = 0, md = 0, dx = 0, dy = 0, damage = 0, cdiv = 0, _
      targets = 2, targetsDestroyed = 0

  GOSUB A100_🎯ResetTargets

  DO
      CLS
      GOSUB A200_🔤CheckKeyboard
      GOSUB A300_🖱CheckMouse 
    
      CALL drawShip( sx, sy, ShipColor )

      GOSUB F100_💥DoWeaponFiring
      GOSUB F200_🛸MoveTargets
      GOSUB F300_☠DoShipBoom
''      IF killflag = 13 THEN LOCATE ( sy - ( sy MOD 16 )) / 16 , MIN( ( sx - ( sx MOD 8 )) / 8, _WIDTH / 8 - 8) : _ENDAUDIO : SOUND 325, 5 : COLOR _RGB32( 255, 255, 0 ) : PRINT " BOOM!!!! "
      _DISPLAY
      SLEEP 0.01
  LOOP UNTIL killflag = 13

  GOSUB Z100_🛑GameOver

  GOTO 🏁🏁🏁ProgramStart🏁🏁🏁
  
  END

'🟠🟠🟠 GOSUB SUBROUTINES

A100_🎯ResetTargets:
    FOR i% = 1 TO targets
        DO
            IF INT( RND * 2 ) = 0 _
               THEN : targetx(i%) = INT( RND * _WIDTH )  : targety(i%) = CHOOSE( INT( RND * 2 ) + 1, 0, YMAX )
               ELSE : targety(i%) = INT( RND * _HEIGHT ) : targetx(i%) = CHOOSE( INT( RND * 2 ) + 1, 0, XMAX )
            END IF
            targetvx(i%) = INT( RND * 2 ) - INT( RND * 2 )
            targetvy(i%) = INT( RND * 2 ) - INT( RND * 2 )
            targetcolor(i%) = _RGB32( INT( 100 + RND * 150 ), _
                                      INT( 100 + RND * 150 ), _
                                      INT( 100 + RND * 150 ) )
            targetalive(i%) = 10
        LOOP UNTIL INT( targetx(i%) / 30 ) <> INT( sx / 20 ) _
               AND INT( targety(i%) / 30 ) <> INT( sy / 30 )
    NEXT i%
    sx = cx
    sy = cy
RETURN

A200_🔤CheckKeyboard:
    ik$ = INKEY$
    SELECT CASE ik$
      CASE "W", "w"
           iy = IFF( sy - 30 >= 0, iy - 4, iy )
           ix = 0
      CASE "A", "a"
           iy = 0
           ix = IFF( sx - 50 >= 0, ix - 4, ix )
      CASE "S", "s"
           iy = IFF( sy + 30 <= YMAX, iy + 4, iy )
           ix = 0
      CASE "D", "d"
           iy = 0
           ix = IFF( sx + 50 <= XMAX, ix + 4, ix )
    END SELECT
RETURN

A300_🖱CheckMouse:
    GETMOUSE mx, my, w%, mb
    dx = mx - sx ' ship avoids collision with mouse
    dy = my - sy
    ma = _ATAN2( dy, dx )
    md = SQR( dy * dy + dx * dx )
    IF md < 80 THEN md = 80
    sx = sx + ix
    sy = sy + iy
    ix = ix / 2
    iy = iy / 2
RETURN

F100_💥DoWeaponFiring:
    IF mb AND md < 301 THEN
       CALL PLC(sx, sy, mx, my, 10 ) : _ENDAUDIO : SOUND 25,1
       ShipColor = _RGB32( INT( RND * 100 ) + 150, _
                           INT( RND * 100 ) + 150, _
                           INT( RND * 100 ) + 150 )
       FOR x = 1 TO targets
           IF INT( targetx(x) / 20 ) = INT( mx / 20 ) AND INT( targety(x) / 20 ) = INT( my / 20 ) AND targetalive(x) > 0 THEN
              damage = 1 + ABS( 10 - INT( RND * SQR(md) ) )
              targetalive(x) = targetalive(x) - damage
              cdiv = ( 20 - targetalive(x) ) / 2
              targetcolor(x) = _RGB32( INT( RND * ( 100 / cdiv ) ) + ( 150 / cdiv ), _
                                       INT( RND * ( 100 / cdiv ) ) + ( 150 / cdiv ), _
                                       INT( RND * ( 100 / cdiv ) ) + ( 150 / cdiv ) )
              _ENDAUDIO : SOUND 95,5
              IF targetalive(x) <= 0 THEN score += 1 : targetsDestroyed += 1
              IF targetsDestroyed = targets THEN targets += IFF( targets <= 47, 3, 0 ) : targetsDestroyed = 0 : GOSUB A100_🎯ResetTargets
           END IF
       NEXT x
    END IF
RETURN

F200_🛸MoveTargets:
    FOR i% = 1 TO targets
        targetx(i%) = targetx(i%) + targetvx(i%)
        targety(i%) = targety(i%) + targetvy(i%)
        IF INT( targetx(i%) / 30 ) = INT( sx / 30 ) AND INT( targety(i%) / 20 ) = INT( sy / 20 ) AND targetalive(i%) > 0 THEN killflag = 13
        IF RND * 100 < 30 THEN
            SELECT CASE INT( RND * 20 )
              CASE 1, 2, 3 'seek ship
                   IF targetx(i%) < sx THEN targetvx(i%) = 2
                   IF targetx(i%) > sx THEN targetvx(i%) = -2
                   IF targety(i%) < sx THEN targetvy(i%) = 2
                   IF targety(i%) > sx THEN targetvy(i%) = -2
              CASE 4, 5    'flee ship
                   IF targetx(i%) < sx THEN targetvx(i%) = -2
                   IF targetx(i%) > sx THEN targetvx(i%) = 2
                   IF targety(i%) < sx THEN targetvy(i%) = -2
                   IF targety(i%) > sx THEN targetvy(i%) = 2
              CASE 7       'rando change
                   targetvy(i%) = targetvy(i%) + INT( RND * 3 ) - INT( RND * 3 )
                   targetvx(i%) = targetvx(i%) + INT( RND * 3 ) - INT( RND * 3 )
            END SELECT
        END IF
        IF targetx(i%) < -20 THEN targetx(i%) = XMAX
        IF targetx(i%) > XMAX + 20 THEN targetx(i%) = 0
        IF targety(i%) < -20 THEN targety(i%) = YMAX
        IF targety(i%) > YMAX + 20 THEN targety(i%) = 0
        IF targetalive(i%) > 0 THEN CALL drawtarget( targetx(i%), targety(i%), targetcolor(i%) )
    NEXT i%
RETURN

F300_☠DoShipBoom:
    IF killflag = 13 _
       THEN LOCATE ( sy - ( sy MOD 16 )) / 16 , MIN( ( sx - ( sx MOD 8 )) / 8, _WIDTH / 8 - 8) : _
            _ENDAUDIO : SOUND 325, 5 : _
            COLOR _RGB32( 255, 255, 0 ) : _
            PRINT " BOOM!!!! "
RETURN

Z100_🛑GameOver:
    _AUTODISPLAY
    _DELAY 1
    CLS
    COLOR _RGB32(255, 255, 0)
    _ENDAUDIO
    SOUND 55, 5 : SOUND 45, 5 : SOUND 55, 5
    PRINT : PRINT "GAME OVER"
    PRINT : PRINT "Score "; (score * score) * 1000
    PRINT : PRINT "Press any key or click the screen to start a new game"
    SLEEP
    CLS
RETURN

'🟠🟠🟠 SUB DEFINITIONS

SUB PLC( baseX, baseY, targetX, targetY, targetR ) ' PLC for PlasmaLaserCannon
    DIM r, g, b, hp, ta, dist, dr, x, y, c, rr
    r = RND ^ 2 * RND: g = RND ^ 2 * RND: b = RND ^ 2 * RND: hp = _PI(.5) ' red, green, blue, half pi
    ta = _ATAN2( targetY - baseY, targetX - baseX ) ' angle of target to cannon base
    dist = SQR( [ ( targetX - baseX ) ^ 2 ] + [ ( targetY - baseY ) ^ 2 ] ) ' distance cannon to target
    dr = targetR / dist
    FOR r = 0 TO dist STEP .25
        x = baseX + r * COS(ta)
        y = baseY + r * SIN(ta)
        c = c + .3
        COLOR _RGB32( 128 + 127 * SIN( r * c ), _
                      128 + 127 * SIN( g * c ), _
                      128 + 127 * SIN( b * c ) )
        CALL fcirc( x, y, dr * r )
    NEXT
    FOR rr = dr * r TO 0 STEP -.5
        c = c + 1
        COLOR _RGB32( 128 + 127 * SIN( r * c ), _
                      128 + 127 * SIN( g * c ), _
                      128 + 127 * SIN( b * c ) )
        CALL fcirc( x, y, rr )
    NEXT rr
END SUB

SUB drawShip( x, y, colr AS ULONG ) 'shipType    collisions same as circle x, y radius = 30
    ' shared here ShipLights

    DIM AS LONG light, r, g, b
    r = _RED(colr) : g = _GREEN(colr) : b = _BLUE(colr)
    COLOR _RGB32( r, g - 120, b - 100 )
    CALL fEllipse( x, y, 6, 15 )
    COLOR _RGB32( r, g - 60, b - 50 )
    CALL fEllipse ( x, y, 18, 11 )
    COLOR _RGB32( r, g, b )
    CALL fEllipse ( x, y, 30, 7 )
    FOR light = 0 TO 5
        COLOR _RGB32( ShipLights * 50, ShipLights * 50, ShipLights * 50 )
        CALL fcirc( x - 30 + 11 * light + ShipLights, y, 1 )
    NEXT light
    ShipLights = IFF( ShipLights + 1 > 5, 0, ShipLights + 1 )
END SUB

SUB drawtarget( x, y, colr AS ULONG ) 'shipType    collisions same as circle x, y radius = 30
    ' shared here ShipLights

    DIM AS LONG light, r, g, b
    r = _RED(colr) : g = _GREEN(colr) : b = _BLUE(colr)
    COLOR _RGB32( r, g - 120, b - 100 )
    CALL fEllipse( x, y, 3, 15 )
    COLOR _RGB32( r, g - 60, b - 50 )
    CALL fEllipse( x, y, 9, 11 )
    COLOR _RGB32( r, g, b )
    CALL fEllipse( x, y, 15, 7 )
    FOR light = 1 TO 3
        COLOR _RGB32( ShipLights * 50, ShipLights * 50, ShipLights * 50 )
        CALL fcirc( x - 30 + 11 * light + ShipLights, y, 1 )
    NEXT light
    ShipLights = IFF( ShipLights + 1 > 5, 0, ShipLights + 1 )
END SUB

SUB fcirc( CX AS Long, CY AS LONG, R AS LONG )
    DIM AS LONG subRadius, RadiusError, X, Y

    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0

    IF subRadius = 0 THEN PSET ( CX, CY ) : EXIT SUB

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE ( CX - X, CY ) TO ( CX + X, CY ), , BF

    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE ( CX - Y, CY - X ) TO ( CX + Y, CY - X ), , BF
                LINE ( CX - Y, CY + X ) TO ( CX + Y, CY + X ), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE ( CX - X, CY - Y ) TO ( CX + X, CY - Y ), , BF
        LINE ( CX - X, CY + Y ) TO ( CX + X, CY + Y ), , BF
    WEND
END SUB

SUB fEllipse(CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)
    DIM scale AS SINGLE, x AS LONG, y AS LONG
    scale = yRadius / xRadius
    LINE ( CX, CY - yRadius ) TO ( CX, CY + yRadius ), , BF
    FOR x = 1 TO xRadius
        y = scale * SQR( xRadius * xRadius - x * x )
        LINE ( CX + x, CY - y ) TO ( CX + x, CY + y ), , BF
        LINE ( CX - x, CY - y ) TO ( CX - x, CY + y ), , BF
    NEXT
END SUB